library(plotly)
alfa = 15 * pi/180
Rotar15 = matrix(
c(cos(alfa), -sin(alfa), 0,
sin(alfa), cos(alfa), 0,
0, 0, 1),
nrow = 3,
ncol = 3,
byrow = TRUE
)
Estirar = matrix(
c(4, 0, 0,
0, 4, 0,
0, 0, 1),
nrow = 3,
ncol = 3,
byrow = TRUE
)
xy = c(1, 1, 1, 2, 4, 2, 4, 1) #x0, y0, x1, y1, x2, y2
transformaciones = list(Rotar15, Rotar15, Rotar15, Estirar)
cuantos <- length(xy)
x = xy[seq(1, cuantos, by = 2)] #Toma cada dos valores el primero (qe seria la x)
y = xy[seq(2, cuantos, by = 2)] #Lo mismo pero con el segundo valor, qe es la y
frame = rep(1, each = cuantos/2) #Los define como del primer frame
xyAnterior = xy #Cada transformacion empieza en los xy qe dejo la anterior
for (it in seq(1, length(transformaciones))) {
rxy = c()
for (i in seq(1, cuantos, by =2)) {
p <- xyAnterior[i:(i+1)] #P tiene el i-esimo xy anterior
r <- transformaciones[it][[1]] %*% append(p, 1) #Le aplico esta transformacion
rxy <- append(rxy, r[1:2]) #Lo guardo para la proxima transformacion
x <- append(x, r[1]) #Lo agrego para armar el dataframe de animar
y <- append(y, r[2])
frame <- append(frame, it+1)
}
xyAnterior <- rxy
}
df <- data.frame(
x,
y,
frame
)
p <- ggplot(df) +
geom_polygon(aes(frame = frame, x= x, y=y), color = "red")
Ignoring unknown aesthetics: frame
ggplotly(p, width = 600, height = 600) %>%
animation_opts(1000)
LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KYGBge3J9DQpsaWJyYXJ5KHBsb3RseSkNCmBgYA0KDQpgYGB7cn0NCmFsZmEgPSAxNSAqIHBpLzE4MA0KDQpSb3RhcjE1ID0gbWF0cml4KA0KICBjKGNvcyhhbGZhKSwgLXNpbihhbGZhKSwgMCwNCiAgICBzaW4oYWxmYSksIGNvcyhhbGZhKSwgMCwNCiAgICAwLCAwLCAxKSwNCiAgbnJvdyA9IDMsDQogIG5jb2wgPSAzLA0KICBieXJvdyA9IFRSVUUNCikNCmBgYA0KDQpgYGB7cn0NCkVzdGlyYXIgPSBtYXRyaXgoDQogIGMoNCwgMCwgMCwNCiAgICAwLCA0LCAwLA0KICAgIDAsIDAsIDEpLA0KICBucm93ID0gMywNCiAgbmNvbCA9IDMsDQogIGJ5cm93ID0gVFJVRQ0KKQ0KYGBgDQoNCmBgYHtyfQ0KeHkgPSBjKDEsIDEsIDEsIDIsIDQsIDIsIDQsIDEpICN4MCwgeTAsIHgxLCB5MSwgeDIsIHkyDQpgYGANCg0KYGBge3J9DQp0cmFuc2Zvcm1hY2lvbmVzID0gbGlzdChSb3RhcjE1LCBSb3RhcjE1LCBSb3RhcjE1LCBFc3RpcmFyKQ0KDQpjdWFudG9zIDwtIGxlbmd0aCh4eSkNCnggPSB4eVtzZXEoMSwgY3VhbnRvcywgYnkgPSAyKV0gI1RvbWEgY2FkYSBkb3MgdmFsb3JlcyBlbCBwcmltZXJvIChxZSBzZXJpYSBsYSB4KQ0KeSA9IHh5W3NlcSgyLCBjdWFudG9zLCBieSA9IDIpXSAjTG8gbWlzbW8gcGVybyBjb24gZWwgc2VndW5kbyB2YWxvciwgcWUgZXMgbGEgeQ0KZnJhbWUgPSByZXAoMSwgZWFjaCA9IGN1YW50b3MvMikgI0xvcyBkZWZpbmUgY29tbyBkZWwgcHJpbWVyIGZyYW1lDQoNCnh5QW50ZXJpb3IgPSB4eSAjQ2FkYSB0cmFuc2Zvcm1hY2lvbiBlbXBpZXphIGVuIGxvcyB4eSBxZSBkZWpvIGxhIGFudGVyaW9yDQpmb3IgKGl0IGluIHNlcSgxLCBsZW5ndGgodHJhbnNmb3JtYWNpb25lcykpKSB7DQogIHJ4eSA9IGMoKQ0KICBmb3IgKGkgaW4gc2VxKDEsIGN1YW50b3MsIGJ5ID0yKSkgew0KICAgIHAgPC0geHlBbnRlcmlvcltpOihpKzEpXSAjUCB0aWVuZSBlbCBpLWVzaW1vIHh5IGFudGVyaW9yDQogICAgciA8LSB0cmFuc2Zvcm1hY2lvbmVzW2l0XVtbMV1dICUqJSBhcHBlbmQocCwgMSkgI0xlIGFwbGljbyBlc3RhIHRyYW5zZm9ybWFjaW9uDQogICAgDQogICAgcnh5IDwtIGFwcGVuZChyeHksIHJbMToyXSkgI0xvIGd1YXJkbyBwYXJhIGxhIHByb3hpbWEgdHJhbnNmb3JtYWNpb24NCiAgICANCiAgICB4IDwtIGFwcGVuZCh4LCByWzFdKSAjTG8gYWdyZWdvIHBhcmEgYXJtYXIgZWwgZGF0YWZyYW1lIGRlIGFuaW1hcg0KICAgIHkgPC0gYXBwZW5kKHksIHJbMl0pDQogICAgZnJhbWUgPC0gYXBwZW5kKGZyYW1lLCBpdCsxKQ0KICB9DQogIHh5QW50ZXJpb3IgPC0gcnh5DQp9DQpgYGANCg0KYGBge3J9DQpkZiA8LSBkYXRhLmZyYW1lKA0KICB4LA0KICB5LA0KICBmcmFtZQ0KKQ0KDQpwIDwtIGdncGxvdChkZikgKw0KICBnZW9tX3BvbHlnb24oYWVzKGZyYW1lID0gZnJhbWUsIHg9IHgsIHk9eSksIGNvbG9yID0gInJlZCIpDQogDQpnZ3Bsb3RseShwLCB3aWR0aCA9IDYwMCwgaGVpZ2h0ID0gNjAwKSAlPiUNCiAgYW5pbWF0aW9uX29wdHMoMTAwMCkNCmBgYA0KDQo=